home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PCGUIA 127
/
PC Guia 127.iso
/
Software
/
Produtividade
/
OpenOffice.org 2.0.1
/
openofficeorg1.cab
/
Currency.xba
< prev
next >
Wrap
Extensible Markup Language
|
2002-11-21
|
6KB
|
178 lines
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Currency" script:language="StarBasic">REM ***** BASIC *****
Option Explicit
Dim bDoUnLoad as Boolean
Sub Startup()
Dim i as Integer
Dim a as Integer
Dim ListString as String
Dim MarketListBoxControl as Object
Initialize(False)
MarketListBoxControl = DlgStartUp.GetControl("lstMarkets")
a = 0
For i = 0 To Ubound(sMarket(),1)
ListString = sMarket(i,0)
If sMarket(i,0) <> "" Then
If sMarket(i,3) = "" Then
ListString = ListString & " (" & sNoInternetUpdate & ")"
Else
ListString = ListString & " (" & sMarketplace & " " & sMarket(i,2) & ")"
End If
MarketListBoxControl.AddItem(ListString, a)
a = a + 1
End If
Next i
MarketListBoxControl.SelectItemPos(GlobListIndex, True)
DlgStartUp.Title = sDepotCurrency
DlgStartUp.Model.cmdGoOn.DefaultButton = True
DlgStartUp.GetControl("lstMarkets").SetFocus()
DlgStartUp.Execute()
DlgStartUp.Dispose()
End Sub
Sub EnableGoOnButton()
StartUpModel.cmdGoOn.Enabled = True
StartUpModel.cmdGoOn.DefaultButton = True
End Sub
Sub CloseStartUpDialog()
DlgStartUp.EndExecute()
' oDocument.Dispose()
End Sub
Sub DisposeDocument()
If bDoUnload Then
oDocument.Dispose()
End If
End Sub
Sub ChooseMarket(Optional aEvent)
Dim Index as Integer
Dim bIsDocLanguage as Boolean
Dim bIsDocCountry as Boolean
oInternetModel = GetControlModel(oDocument.Sheets(0), "CmdInternet")
If Not IsMissing(aEvent) Then
Index = StartupModel.lstMarkets.SelectedItems(0)
oInternetModel.Tag = Index
Else
Index = oInternetModel.Tag
End If
oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory")
sCurCurrency = sMarket(Index,1)
If Index = 0 Then
HistoryChartSource = sMarket(Index,4)
End If
sCurStockIDLabel = sMarket(Index,5)
sCurExtension = sMarket(Index,8)
iValueCol = Val(sMarket(Index,10)
If Instr(sCurExtension,";") <> 0 Then
' Take the german extension as the stock place is Frankfurt
sCurExtension = "407"
End If
sCurChartSource = sMarket(Index,3)
bIsDocLanguage = Instr(1, sMarket(Index,6), sDocLanguage, SBBINARY) <> 0
bIsDocCountry = Instr(1, sMarket(Index,7), sDocCountry, SBBINARY) <> 0 OR SDocCountry = ""
sCurSeparator = sMarket(Index,9)
TransactModel.txtRate.CurrencySymbol = sCurCurrency
TransactModel.txtFix.CurrencySymbol = sCurCurrency
TransactModel.txtMinimum.CurrencySymbol = sCurCurrency
bEnableMarket = Index = 0
bEnableInternet = sCurChartSource <> ""
oMarketModel.Enabled = bEnableMarket
oInternetModel.Enabled = bEnableInternet
If Not IsMissing(aEvent) Then
ConvertStylesCurrencies()
bDoUnload = False
DlgStartUp.EndExecute()
End If
End Sub
Sub ConvertStylesCurrencies()
Dim m as integer
Dim aStyleFormat as Object
Dim StyleName as String
Dim bAddToList as Boolean
Dim oStyle as Object
Dim oStyles as Object
UnprotectSheets(oSheets)
oFirstSheet.GetCellByPosition(SBCOLUMNID1, SBROWHEADER1).SetString(sCurStockIDLabel)
oStyles = oDocument.StyleFamilies.GetbyIndex(0)
For m = 0 To oStyles.count-1
oStyle = oStyles.GetbyIndex(m)
StyleName = oStyle.Name
bAddToList = CheckFormatType(oStyle)
If bAddToList Then
SwitchNumberFormat(ostyle, oDocFormats, sCurCurrency, sCurExtension)
End If
Next m
ProtectSheets(oSheets)
End Sub
Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String, sNewExtension as String)
Dim nFormatLanguage as Integer
Dim nFormatDecimals as Integer
Dim nFormatLeading as Integer
Dim bFormatLeading as Integer
Dim bFormatNegRed as Integer
Dim bFormatThousands as Integer
Dim aNewStr as String
Dim iNumberFormat as Long
Dim sSimpleStr as String
Dim nSimpleKey as Long
Dim aFormat()
Dim oLocale as New com.sun.star.lang.Locale
' Numberformat with the new Symbol as Base for new Format
sSimpleStr = "0 [$" & sNewSymbol & "-" & sNewExtension & "]"
nSimpleKey = Numberformat(oFormats, sSimpleStr, oDocLocale)
On Local Error Resume Next
iNumberFormat = oObject.NumberFormat
If Err <> 0 Then
Msgbox "Error Reading the Number Format"
Resume CLERROR
End If
On Local Error GoTo NOKEY
aFormat() = oFormats.getByKey(iNumberFormat)
On Local Error GoTo 0
' set new currency format with according settings
nFormatDecimals = aFormat.Decimals
nFormatLeading = aFormat.LeadingZeros
bFormatNegRed = aFormat.NegativeRed
bFormatThousands = aFormat.ThousandsSeparator
oLocale = aFormat.Locale
aNewStr = oFormats.generateFormat(nSimpleKey, oLocale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading)
oObject.NumberFormat = Numberformat(oFormats, aNewStr, oLocale)
NOKEY:
If Err <> 0 Then
Resume CLERROR
End If
CLERROR:
End Sub
Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Variant )
Dim nRetkey
nRetKey = oFormats.queryKey(aFormatStr, oLocale, True)
If nRetKey = -1 Then
nRetKey = oFormats.addNew( aFormatStr, oLocale )
If nRetKey = -1 Then nRetKey = 0
End If
Numberformat = nRetKey
End Function
Function CheckFormatType(oStyle as Object)
Dim oFormatofObject as Object
oFormatofObject = oDocFormats.getByKey(oStyle.NumberFormat)
CheckFormatType = INT(oFormatOfObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
End Function</script:module>